Pascal Super Library/Pascal Super Library (CW International)(1997).bin/MENU_UTL/CO39/SCLPTEXT.PAS

Pascal/Delphi Source File | 1992-08-10 | 5KB | 177 lines

{SclpText - Extensions to ObjectWindows Copyright (C) Doug Overmyer 7/1/91}
unit SclpText;
{***********************  Interface     **************************}
interface
uses WinTypes, WinProcs, WinDos, Strings, WObjects;
const
    sr_Recessed     =   1;
  sr_Raised       =   0;
type
PSRect = ^TSRect;
TSRect = object(TWindow)
  W,H:Integer;
    State:Integer;
  constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
      NewX,NewY,NewW,NewH:Integer; NewState:Integer);
  destructor Done;virtual;
  procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  procedure MoveWin(NewX,NewY,NewW,NewH:Integer);
end;

type
PSText = ^TSText;
TSText = object(TSRect)
    Text:Array [0..80] of Char;
  DTStyle:Integer;
  DTFont:hfont;
  constructor Init(AParent:PWindowsObject;AnID:Integer; ATitle:PChar;
      NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
  destructor Done;virtual;
  procedure Paint(PaintDC:HDC; var PaintInfo:TPaintStruct);virtual;
  procedure SetText(NewText:PChar);virtual;
  procedure SetFont(NewFont:HFont);virtual;
end;

{***********************  Implementation          *******************}
implementation

{***********************         TSRect         *********************}
constructor TSRect.Init(AParent:PWindowsObject; AnID:Integer;
    ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState:Integer);
begin
    TWindow.Init(AParent,ATitle);
  Attr.Style := ws_Child or ws_visible ;
  Attr.X := NewX;
  Attr.Y := NewY;
  Attr.W := NewW;
  Attr.H := NewH;
  Attr.ID := AnID;
  W := NewW;
  H := NewH;
  if NewState = sr_Recessed then
      State := sr_Recessed
    else
        State := sr_Raised;

end;

destructor TSRect.Done;
begin
    TWindow.Done;
end;

procedure TSRect.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
  LPts:Array[0..2] of TPoint;
  RPts:Array[0..2] of TPoint;
    ThePen:HPen;
  Pen1:HPen;
  Pen2:HPen;
  TheBrush :HBrush;
  OldBrush :HBrush;
  OldPen:HPen;
  OldBkMode:Integer;
  DRect:TRect;
  Ofs:Integer;
begin
  TheBrush := GetStockObject(ltGray_Brush);    {Draw window background}
  OldBrush := SelectObject(PaintDC,TheBrush);
  Rectangle(PaintDC,0,0,W,H);
  SelectObject(PaintDC,OldBrush);

  Ofs := 0;
    LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
    LPts[1].x := Ofs;   LPts[1].y := Ofs;
  LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
    RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
    RPts[2].x := W-Ofs; RPts[2].y := Ofs;

    Pen1 := CreatePen(ps_Solid,1,$00000000);  {Draw a surrounding blk frame}
  OldPen := SelectObject(PaintDC,Pen1);
  PolyLine(PaintDC,LPts,3);
  PolyLine(PaintDC,RPts,3);
  SelectObject(PaintDC,OldPen);
  DeleteObject(Pen1);

  Ofs := 1;
    LPts[0].x := Ofs;   LPts[0].y := H-Ofs;
    LPts[1].x := Ofs;   LPts[1].y := Ofs;
  LPts[2].x := W-Ofs; LPts[2].y := Ofs;
  RPts[0].x := Ofs;   RPts[0].y := H-Ofs;
    RPts[1].x := W-Ofs; RPts[1].y := H-Ofs;
    RPts[2].x := W-Ofs; RPts[2].y := Ofs;
  if State = sr_Raised then
      begin
        Pen1 := CreatePen(ps_Solid,1,$00FFFFFF);
    Pen2 := CreatePen(ps_Solid,1,$00808080);
    end
  else
      begin
      Pen1 := CreatePen(ps_Solid,1,$00808080);
        Pen2 := CreatePen(ps_Solid,1,$00FFFFFF);
    end;

  OldPen := SelectObject(PaintDC,Pen1);   {Draw the highlights}
  PolyLine(PaintDC,LPts,3);
  SelectObject(PaintDC,Pen2);
  DeleteObject(Pen1);

  PolyLine(PaintDC,RPts,3);
  SelectObject(PaintDC,OldPen);
  DeleteObject(Pen2);
end;
procedure TSRect.MoveWin(NewX,NewY,NewW,NewH:Integer);
begin
  W := NewW;
  H := NewH;
  MoveWindow(HWindow,NewX,NewY,NewW,NewH,True);
end;
{************************   TSText   ********************************}
constructor TSText.Init(AParent:PWindowsObject; AnID:Integer;
    ATitle:PChar;    NewX,NewY,NewW,NewH:Integer; NewState,NewStyle:Integer);
begin
    TSRect.Init(AParent,AnID,ATitle,NewX,NewY,NewW,NewH,NewState);
  DTStyle := NewStyle;
  StrCopy(Text,ATitle);
  DTFont := 0;
end;

destructor TSText.Done;
begin
    TSRect.Done;
end;

procedure TSText.Paint(PaintDC:HDC;var PaintInfo:TPaintStruct);
var
  OldBkMode:Integer;
  DRect:TRect;
  OldFont:hFont;
begin
  TSRect.Paint(PaintDC,PaintInfo);
  OldFont := 0;
  if DTFont <> 0 then
      OldFont := SelectObject(PaintDC,DTFont);
  OldBkMode := SetBkMode(PaintDC,Transparent);  {Draw the text}
  DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  DrawText(PaintDC,Text,StrLen(Text),DRect,DTStyle);
  SetBkMode(PaintDC,OldBkMode);
  If OldFont > 0 then
      SelectObject(PaintDC,OldFont);
end;

procedure TSText.SetText(NewText:PChar);
var
    DRect:TRect;
begin
    StrCopy(Text,NewText);
  DRect.left := 3;DRect.Top := 2;DRect.right := W-3;DRect.Bottom := H-2;
  InvalidateRect(HWindow,@DRect,false);
end;

procedure TSText.SetFont(NewFont:HFont);
begin
    DTFont := NewFont;
end;
end.